Hi From the News
Page 12
Hi
Index Page 11 | Nomenclature


      Run.vbs  Tested in Win98/XP.
      HTA  --- HTA / HTM(L) code with options; Edit Source or Print.
               You can replace an HTM(L) extension with HTA instead, ;-).   
      New.vbs  Template. Tested in Win98.
      COUNT.(BAT, HTA or VBS)  Hexadecimal Counting in the Registry.
      Description.HTA  Take notes about file(s).
      Any extension such as HTM HTML HTA or VBS,
               A little synopsis of VBScript, JavaScript and DOS Batch...
      About colors  VBScript


  Run.vbs

 Win9X/XP



:'[ This VBScript is 328 lines, 12.025 bytes (this line excluded) ].
' You can put this VBScript either in
' your Startup Folder, or else where.
'
' In Startup Folder:
'       After each boot, a record would be created in TEMP.
'       If a virus; something or someone modifyied your
'       system, it would be yelling and you'll know.
'
' If else where:
'       On double click, a record would be created in TEMP.
'       Note: Comprehensive information, (if found).
'
'
' Benny Pedersen,
' http://2dos.homepage.dk

'_______[Variable:]
'
dim debuging: debuging= false
dim fso, wso, runPath, tmpPath, oSystem, VBScriptStartup
dim tempFile, destFile, backFile
set fso= createObject("scripting.fileSystemObject")
set wso= createObject("wScript.shell")
runPath= wso.specialFolders("startup")
tmpPath= wso.expandEnvironmentStrings("%TEMP%") & ".\"
oSystem= wso.expandEnvironmentStrings( "%OS%" )
if oSystem = "Windows_NT" then dim oXP
if (uCase(fso.getParentFolderName(wScript.scriptFullName))) = _
   (uCase(runPath)) then
     VBScriptStartup= true
else VBScriptStartup= false
end if
tempFile= fso.getAbsolutePathName(tmpPath & "_Run_.tmp")
destFile= fso.getAbsolutePathName(tmpPath & "_Run_.reg")
backFile= fso.getAbsolutePathName(tmpPath & "_Run_Old.reg")
const forReading= 1, forAppending= 8
dim i, rFile, aFile
dim hKey: const sKey= "Software\Microsoft\Windows\CurrentVersion\"

'_______[Test write protection:]
'
if (fso.fileExists(destFile)) then
    on error resume next
              fso.copyFile destFile, backFile: fso.deleteFile backFile
    if err.number>0 then
       wso.run"explorer """ & fso.getParentFolderName(backFile) & """"
       wScript.sleep(500)
       msgBox vbTab & "Error:" & vbCrLf & vbCrLf _
            & wScript.scriptFullName & vbCrLf & vbCrLf _
            & "Said: Those are mine! Remove write protection or prot"_
            & "ected file(s):" & vbCrLf & vbCrLf & vbTab _
            & destFile & vbCrLf & vbTab & backFile,, "OOPS!"
       wso.run"wScript.exe """ & wScript.scriptFullName & """",, false
       Quit
    end if
    on error goTo 0
end if

'_______
'
if VBScriptStartup then
     if (fso.fileExists(destFile)) then
        fso.copyFile destFile, backFile
        RegExporting : WinIni : Startup
        if (fso.getFile(destFile).size)=(fso.getFile(backFile).size) _
        then
             fso.deleteFile(backFile)
        else wso.run"explorer "& fso.getParentFolderName(backFile),,-1
             wScript.sleep(500)
             wso.run"%comSpec% /kFc.exe /n /a /Lb1 /c """ _
                   & destFile & """ """ & backFile & """"
             wScript.sleep(800)
             msgBox """" & destFile & """" & vbCrLf _
                  & """" & backFile & """",, "Differences encountered"
        end if
     else RegExporting: WinIni: Startup
     end if
else dim modifyied
     RegExporting: modifyied = InfoWithRegEditOptions: WinIni: Startup
     if modifyied then
        wso.run "explorer " & fso.getParentFolderName(destFile),, true
        wScript.sleep(500)
        if oSystem = "Windows_NT" then
             modifyied= left(mid(runPath, inStr(5, runPath, "\") +1, _
                        50), inStr(2, mid(runPath, inStr(5, runPath, _
                        "\") +1, 50), "\") -1)
        else modifyied= GetReg("HKCU\Software\Microsoft\MS Setup (A" _
                     & "CME)\User Info\DefName")
        end if
        msgBox "You have modifyied the Registry. To undo, just run " _
             & "the file named: " & vbCrLf _
             & """" & destFile & """", 64, modifyied
     end if
end if
Quit

'_______1 [Exporting "Run Keys":]
'
sub RegExporting
  wso.run"%comSpec% /cEcho.REGEDIT4>""" & destFile & """", 0, true
  for each hKey in array ("HKEY_CURRENT_USER\", "HKEY_LOCAL_MACHINE\")
     for each i in array ("Run","Runonce","RunServices",_
                          "RunServicesOnce","RunOnceEx")
        if debuging then
           MSGBOX"Ready to export:" & vbCrLf & vbCrLf _
                & hKey & sKey & i & vbCrLf & vbCrLf _
                & "to: """ & tempFile & """" & vbCrLf & vbCrLf _
                & "using function/sub named: RegExport",, "JOB id 108"
        end if
        on error resume next
        wso.regRead(hKey & sKey & i & "\")
        if (err.number) <> 0 then
             on error goTo 0
             if oSystem = "Windows_NT" then
                  RegExport hKey & sKey & i, """" & tempFile & """"
                  set rFile= fso.openTextFile(tempFile, forReading)
                  for oXP=1 to 2: rFile.skipLine: next
                  oXP= uCase(Skip(rFile.readLine))
                  rFile.close
                  if mid(oXP,2,len(oXP)-2)=uCase(hKey & sKey & i) then
                       FileAppend destFile, tempFile
                       if debuging then MSGBOX "JOB 108 was done. " _
                                             & "Appended.",, "WinXP"
                  else if debuging then MSGBOX "JOB 108 should fai" _
                                             & "ls. Done.",, "WinXP"
                  end if
             else if debuging then MSGBOX "JOB 108 should fai" _
                                        & "ls. Done.",, "Win98"
             end if
        else on error goTo 0
             RegExport hKey & sKey & i, """" & tempFile & """"
             FileAppend destFile, tempFile
             if debuging then MSGBOX "JOB 115 was done. " _
                                   & "Appended.",, "Win98"
        end if
     next
  next
  if fso.fileExists(tempFile) then fso.deleteFile tempFile
end sub

'_______2 [Displays some information.
'          Allows modify of Registry:] (destFile is not modifyied.)
'
function InfoWithRegEditOptions
  dim regKey, countKeys, cl, regItem, countItems, regPath
  dim regValue, mon, user, msg, regNew, modifyied
  modifyied= false
  set rFile= fso.openTextFile(destFile, forReading)
  on error resume next
  do until err.number<>0
    if regItem="" then
      do: regKey= rFile.readLine
      loop until left(regKey,1) = "[" OR err.number <> 0
      countKeys= countKeys +1
      regItem= rFile.readLine
      cl= 0
    end if
    if regItem<>"" then
      cl= cl +1
      countItems= countItems +1
      regPath= replace(mid(regKey, 2), "]", "\") & mid(regItem, 2)
      regPath= left(regPath, inStr(1, regPath, """") -1)
      regPath= replace(regPath, "HKEY_CURRENT_USER", "HKCU")
      regPath= replace(regPath, "HKEY_LOCAL_MACHINE","HKLM")
      regValue= getReg(regPath)
      if oSystem = "Windows_NT" then
           mon=GetReg("HKLM\SYSTEM\ControlSet001\Hardware Profiles\"_
             & "0001\System\CurrentControlSet\Control\VIDEO\{9CC278"_
             & "30-04A7-429D-93A9-88E18751C167}\0000\DefaultSetting"_
             & "s.XResolution")
      else mon=GetReg("HKLM\Config\0001\Display\Settings\Resolution")
      end if
      select case left(mon, 3)
             case "102" I=string(5, vbTab) & string(10, " "): mon=102
             case "800" I=string(4, vbTab) & string( 3, " "): mon= 78
             case else  I=string(3, vbTab) & string( 3, " "): mon= 62
      end select
      user= msgBox(I & "*** Format ***" _
                       & vbCrLf & vbCrLf & string(mon,"_") & vbCrLf _
             & "Export/Import:" & vbCrLf & vbCrLf _
             & vbTab & regKey   & vbCrLf _
             & vbTab & regItem  & vbCrLf & vbCrLf _
                                & vbCrLf & string(mon,"_") & vbCrLf _
             & "WSH:"           & vbCrLf & vbCrLf _
             & vbTab & regPath  & vbCrLf _
             & vbTab & regValue & vbCrLf & vbCrLf & string(mon,"_") _
                                & vbCrLf & vbCrLf, 1, _
             countItems & "; (" & countKeys & "." & cl & ")")
      if user -1 then
        msg= replace(regPath, "\", "\" & vbCrLf & vbTab) & vbCrLf
        regNew= inputBox(msg & vbCrLf & "Press ESC / (Hit"_
             & " Cancel) to remove, or use this value: ", _
             "RegistryEditor", regValue)
        if regNew = "" then
             wso.regDelete regPath
        else if inStr(1, regItem, "=dword:") then
                  wso.regWrite regPath, regNew, "REG_DWORD"
             else wso.regWrite regPath, regNew
             end if
        end if
        if not uCase(regNew)=uCase(regValue) then modifyied= true
      end if
      regItem= rFile.readLine
    end if
  loop
  on error goTo 0
  rFile.close
  if countItems=0 then msgBox "No information.",, "Comprehensive info"
  InfoWithRegEditOptions= modifyied
end function

'_______3 [Append comments about Win.ini:]
'
sub WinIni
  dim sourceFile
  sourceFile=wso.expandEnvironmentStrings("%WinDir%") & ".\Win.ini"
  if not (fso.fileExists(sourceFile)) then exit sub
  sourceFile=fso.getFile(sourceFile)
  dim sourceTxt, th1found, pos, e
  set rFile= fso.openTextFile(sourceFile, forReading)
  set aFile= fso.openTextFile(destFile, forAppending)
  sourceTxt= split(rFile.readAll, vbCrLf)
  rFile.close
  th1found= false
  for i = 0 to uBound(sourceTxt)
      pos= inStr(4, sourceTxt(i), "=")
      for each e in array("RUN=", "LOAD=", "DEVICE=")
         if uCase(e) = left(uCase(sourceTxt(i)), pos) then
            if mid(sourceTxt(i), pos +1)<>"" then
               if not th1found then
                   th1found= true
                   aFile.write ";" & vbCrLf _
                             & "; *** [" & sourceFile & "]"
               end if
               aFile.write vbCrLf & "; (Line num "& i+1 & ":) "_
                         & sourceTxt(i)
            end if
            exit for
         end if
      next
  next
  if th1found then aFile.write vbCrLf
  aFile.close
end sub

'_______4 [Append comments about StartUp:]
'
sub Startup
  dim fileList
  fileList= split(GetFileList(runPath, false, ""), "*")
  if VBScriptStartup and uBound(fileList) = 1 then exit sub
  set aFile= fso.openTextFile(destFile, forAppending)
  if uBound(fileList) > 0 then
      aFile.write ";" & vbCrLf & "; *** [StartUp]"
      for i=1 to uBound(fileList)
        if not uCase(fileList(i)) = uCase(wScript.scriptFullName) then
           aFile.write vbCrLf & "; " & fileList(i)
        end if
      next
      aFile.write vbCrLf
  end if
  aFile.close
end sub

'_______[Other functions and sub routines:]
'
function GetReg(reg)
  on error resume next: GetReg= wso.regRead(reg)
  on error goTo 0
end function

sub RegExport(regKey, destFile)
  if left(destFile,1) <> """" then
       RegExport regKey, """" & destFile & """"
  else wso.run "regEdit.exe /e " _
       & destFile & " " & regKey, 0, true
  end if
end sub

sub FileAppend(destFile, sourceFile)
  set rFile= fso.openTextFile(sourceFile, forReading)
  set aFile= fso.openTextFile(destFile, forAppending)
  for i=1 to 2: rFile.skipLine: next
  do: I= Skip(rFile.readLine)
      if I="" then aFile.write vbCrLf: exit do
      aFile.write I & vbCrLf
  loop
  rFile.close
  aFile.close
end sub

function GetFileList(FolderSpec, Recurse, List)
  dim f
  for each f in fso.getFolder(FolderSpec).files
     List= List & "*" & f.path
  next
  if Recurse then
     for each f in fso.getFolder(FolderSpec).subfolders
        GetFileList f.path, Recurse, List
     next
  end if
  GetFileList= List
end function

function Skip(strng)
  Skip= strng
  if oSystem = "Windows_NT" then
     Skip= replace(Skip, chr(000), "")
     Skip= replace(Skip, chr(013), "")
  end if
end function

sub ShowHere(flag)' Ex.: ShowHere(99+blue)
  wso.run"%comSpec% /cEcho exit|%comSpec% /kPrompt fB800:0LFA0' '" _
        & flag & "$_q|debug>nul", 1, true
  if oSystem = "Windows_NT" then
        wso.run "%comSpec% /cDel """ & tmpPath & "scs?*.tmp""", 0
  end if
end sub

'_______[Clean up and Exit:]
'
sub Quit
  set fso= nothing
' ShowHere(22+green)'[Blink to show that's terminated OK.]
  set wso= nothing
  wScript.quit
end sub

Notes/etc.





  Links:
   


 


<html><head><title>testing</title>
<HTA:APPLICATION id=    "test"
        applicationName="testing"
        singleInstance= "yes"
        border=         "thick"
        caption=        "yes"
        sysMenu=        "yes"
        windowState=    "maximize"
        showInTaskBar=  "yes">
</head><body bgColor="#C0C0C0">
<script language="JavaScript">
  function mouseClicks(){
        alert("Close the current HTML page, (press Alt+F4).");}
  function printing()   {
        window.print(); }
</script>
<script language="VBScript">
  if uCase(right(location.pathname, 8)) = ".HTA.HTM" then
        document.bgColor = "#FFFFFF"
        msgBox "After the printing has started, then close the curr" _
                & "ent HTML page, (press Alt+F4).",64,"Ready to print"
        printing(): document.onclick = mouseClicks
  else  dim wso: set wso= createObject("wScript.shell")
        dim fso: set fso= createObject("scripting.fileSystemObject")
        dim editor: editor= wso.expandEnvironmentStrings("%winDir%") _
                                                & "\Command\Pfe32.exe"
        if (fso.fileExists(editor)) then
                editor= editor & " /g"& 32
                editor= editor & "/" &  43
        else    editor= "notepad"
        end if
  end if
</script>

<H3>Testing</H3>
<FORM method="get">
   <select name="menu" onchange="scriptForMenu(value)"
                style="background-color:#99CCFF; font-weight:bold;">
        <option selected value="">      </option>
        <option value="Source">Source   </option>
        <option value="Print"> Print    </option>
   </select>
   <script language="VBScript">
     sub scriptForMenu(X)
        dim f, ext
        f= location.pathname: ext= uCase(mid(f, inStrRev(f,"."), 4))
        select case (X & ext)
            case "Source.HTA"   wso.run editor & " """ & f & """",3,-1
            case "Source.HTM"   wso.run editor & " """ & mid(f, _
                                inStr(1, f, ":") -1) & """",3,-1
            case "Print.HTA"    fso.copyFile f,f & ".htm"
                                wso.run """" & f & ".htm""",3,-1
                                fso.deleteFile f & ".htm"
            case "Print.HTM"    printing()
        end select
        document.location.reload()
     end sub
   </script>
</FORM>

</body></html>


' Template for VBScripting, "C:\WINDOWS\ShellNew\New.VBS".
' [HKEY_CLASSES_ROOT\.VBS\ShellNew]
' "FileName"="New.vbs"

dim wso, fso, oSystem, tmpPath, tmpFile
set wso= createObject("wScript.shell")
set fso= createObject("scripting.fileSystemObject")
oSystem= wso.expandEnvironmentStrings("%OS%") & "/XPWindows_98/ME"
oSystem= mid(oSystem, inStr(1, oSystem, "W"), 13)
tmpPath= wso.expandEnvironmentStrings("%TEMP%") & "*" _
       & wso.expandEnvironmentStrings("%TMP%") & "*C:\"
tmpPath= Search(tmpPath, "\", "*") & ".\"
tmpFile= fso.getAbsolutePathName(tmpPath & "fileName.tmp")

msgBox "OS: " & vbTab & oSystem & vbCrLf & "Tmp: " & vbTab & tmpPath _
       & vbCrLf & "TmpFile: " & vbTab & tmpFile, 64, "Info ;-)"

dim f: set f= fso.openTextFile(tmpFile, 2, true)
dim i, fileList:  fileList= split(GetFileList(tmpPath, false, 0), "*")
for i=1 to uBound(fileList)
  if msgBox(fileList(i), 65,i & ";"& uBound(fileList))=2 then exit for
  f.writeLine fileList(i)
next
f.close:  set f= nothing

wso.run "notepad """ & tmpFile & """",, -1
fso.deleteFile tmpFile, true

set wso= nothing
set fso= nothing
wScript.quit

' Return first element that contains x:
function Search(strng, x, delim)
  search= delim & strng & delim
  search= mid(left(search,inStr(inStr(2,search,x),search,delim) -1), _
          inStrRev(search,delim,inStr(2,search,x) -1) +1)
end function

function GetFileList(folderSpec, recurse, list1)
  dim f
  for each f in fso.getFolder(folderSpec).files
        list1= list1 & "*" & f.path
  next
  if recurse then
        for each f in fso.getFolder(folderSpec).subfolders
                GetFileList f.path, recurse, list1
        next
  end if
  GetFileList= list1
end function

function GetFolderList(folderSpec, recurse, list2)
  dim f
  for each f in fso.getFolder(folderSpec).subfolders
        list2= list2 & "*" & f.path
  next
  if recurse then
        for each f in fso.getFolder(folderSpec).subfolders
                GetFolderList f.path, recurse, list2
        next
  end if
  GetFolderList= list2
end function

' Additional syntax to remember:
' =inputBox("msg:", ";-)", default)
' wso.popup "msg.", 9, ";-)", 64



Hex Counter in the Registry.

Filename: "COUNT.BAT" or "COUNT.HTA"

Note: For extension VBS instead, then delete the three
      first lines along with the last, (line numb 17).

<!--
@  for %%c in (echo:off,copy:%0:%0.HTA,cls,"start %0.HTA",exit) do %%c
--><SCRIPT language="VBScript">
   dim wso, C0, restoreCounter0_value: restoreCounter0_value= 4
   set wso= createObject("wScript.shell")
   on error resume next: C0= wso.regRead("HKCU\myKeys\Counter0")
   on error goTo 0
   C0= right("0000" & hex(cInt("&h" & (0 & C0)) +1), 4)
   if restoreCounter0_value <= cInt("&h" & C0) then
        wso.regDelete"HKCU\myKeys\Counter0"
   else wso.regWrite "HKCU\myKeys\Counter0", C0
   end if
   wso.popup _
   "Counter0:" & vbCrLf & vbCrLf & vbTab & cInt("&h" & ("0" & C0)) &_
   " (" & C0 & " hex)." & vbCrLf, 02, "HKEY_CURRENT_USER\myKeys\", 64
   set wso= nothing: on error resume next: self.close(): wScript.quit
</SCRIPT>


  Description.HTA  (do NOT use the extension HTM or HTML).


TIPS: Run "Description.HTA" from within a folder with some DOC or ZIP files.



NOTE: If you have installed the very BAD virus namely "Norton's Anti Virus",
then the Description.HTA won't work very fine. If so, then you should simply
get an Anti-Virus-Software which isn't a virus itself; and you'll be allowed
to use your computer for simple batch programming BAT, HTA, WSF, VBS, etc...

<html><head><title>Take Note(s).</title><style>td{font-family:verdana,
  system; font-size:12px; color:#000000; font-weight:bold; }</style>
<hta:application applicationName="Description" singleInstance="yes">
<script language="VBScript">
  dim default: default= "" '***[Or you can use default= "Downloaded "]
  dim thisFile: thisFile= replace(location.pathname,"%20"," ")
  dim fso: set fso= createObject("scripting.fileSystemObject")
  '____
  function GetFileList(spec, recurse, list)
    dim f
    for each f in fso.getFolder(spec).files
        list= list & "*" & f.path
    next
    if recurse then
        for each f in fso.getFolder(spec).subfolders
            GetFileList f.path, recurse, list
        next
    end if
    GetFileList= split(list,"*")
  end function
  '____
  sub Upd_(list): dim f, contents, LineNumb, id
    set f= fso.openTextFile(thisFile, 1)
    contents= split(vbCrlf & f.readAll, vbCrlf)
    f.close : set f= fso.openTextFile(thisFile, 2, true)
    do:     LineNumb= LineNumb +1
            f.writeLine contents(LineNumb)
    loop until "<hR>" = contents(LineNumb)
    if contents(LineNumb +2) = contents(uBound(contents)-1) then
       f.writeLine"<!-- --><p>&nbsp;<table border=""1"" bgColor=""" &_
       "#C0C0C0""><tr><td>Go</td><td>Filename</td><td>Notes</td></tr>"
       for id=1 to uBound(list)
          f.writeLine"<tr><td><input type='button' value='" _
          & " ' onClick='TakeNote " & id & "'></td>" & vbCrLf _
          & "<td>" & fso.getFileName(list(id)) & "</td>"
          if list(id) = thisFile then
               f.writeLine"<td>http://2dos.homepage.dk</td></tr>"
          else f.writeLine"<td></td></tr>"
          end if
       next
    else
       dim ListWrote
       LineNumb= LineNumb +1: f.writeLine contents(LineNumb)
       do until contents(LineNumb+1)=contents(uBound(contents)-1)
          if fso.fileExists(mid(contents(LineNumb+2), 5, _
          len(contents(LineNumb+2))-9)) then
               id= id +1
               f.writeLine left(contents(LineNumb +1), 57) & id _
                 & "'></td>" & vbCrLf & contents(LineNumb +2) _
                 & vbCrLf & contents(LineNumb +3)
               ListWrote= "*" & contents(LineNumb +2) & ListWrote
          end if
          LineNumb= LineNumb +3
       loop:   ListWrote= split(ListWrote, "*")
       if uBound(list) > uBound(ListWrote) then
       ' msgBox uBound(list)-uBound(ListWrote)&" new name(s) detected"
         dim i, j, ListNewNames
         for i = 1 to uBound(List)
             for j = 1 to uBound(ListWrote)
                 if uCase(fso.getFileName(list(i))) = _
                 uCase(mid(replace(ListWrote(j),"</td>",""), 5)) then
                      list(i)= "": exit for
                 end if
             next
             if not list(i) = "" then
                 ListNewNames= ListNewNames & "*" & list(i)
             end if
         next
         ListNewNames= split(ListNewNames, "*")
         for i = 1 to uBound(ListNewNames)
             id = id +1
             f.writeLine "<tr><td><input type='button' value=' ' on" _
               & "Click='TakeNote " & id & "'></td>" & vbCrLf _
               & "<td>" & fso.getFileName(ListNewNames(i)) & "</td>" _
               & vbCrLf & "<td></td></tr>"
         next
       end if
    end if
    f.writeLine contents(uBound(contents)-1)
    document.location.reload(): f.close: set f= nothing
  end sub
  '____
  sub TakeNote(id): dim f, contents, LineNumb, takeNoteInLineNumb, put
    set f= fso.openTextFile(thisFile, 1)
    contents= split(vbCrlf & f.readAll, vbCrlf)
    f.close : set f= fso.openTextFile(thisFile, 2, true)
    for LineNumb = 1 to uBound(contents) -1
        if LineNumb = -takeNoteInLineNumb then
             if contents(LineNumb) = "<td></td></tr>" then
                  default= default & date & ". "
             else default= mid(contents(LineNumb), 5, _
                           len(contents(LineNumb))-14)
             end if
             put= inputBox("Description:", "", default,, 0)
             if typeName(put) = "Empty" then
                  f.writeLine contents(LineNumb)
             else f.writeLine "<td>" & put & "</td></tr>"
             end if
        else f.writeLine contents(LineNumb)
             if "<hR>" = contents(LineNumb) then
                  takeNoteInLineNumb= -3*id -LineNumb -1
             end if
        end if
    next: document.location.reload(): f.close: set f= nothing
  end sub
</script></head><body bgColor="#000080">
<input type=button value='Update'onClick='Upd_(GetFileList(".",0,0))'>
<hR>
<!-- --><table bgColor="yellow"><tr><td>Press button Update.</td></tr>
<!-- --></table></head></html>

Any extension on "Synopsis.HTM"
'<!-- Line num 1 is next line, including the prefixed single quote -->
'
'This file can (without modifying anything) be named with an extension
'                            of one of the following: HTM HTML HTA VBS
'
'<SCRIPT type="text/VBS">
'---------------------------------------------------------------------
' VBScript              '  JavaScript                   //  DOS     ::
'---------------------------------------------------------------------
  dim a: a=12345        '  var a=12345                  //
  a=cStr(a)             '  a=String(a)                  //
  a=mid(a,1,len(a)-1)   '  a=a.slice(0,a.length-1)      //  set a=1234
  msgBox a,, ";-)"      '  alert(a)                     //  echo.%a%
'---------------------------------------------------------------------
'</SCRIPT><SCRIPT language="JScript">status='Done;-)';close()</SCRIPT>
'
'
'Benny Pedersen, http://2dos.homepage.dk/
'PS. Tested in Win98(4.10.1998), IE6 SP1.


About colors (under construction).

' Make216colors.VBS
dim fullySpecFile_W: fullySpecFile_W = "D:\Colors.txt"
if vbCancel = _
   msgBox("This VBScript would make a file named" & vbCrLf _
        & """" & fullySpecFile_W & """." & vbCrLf & vbCrLf _
        & "Contents: " & "216 colors (if you don't exclude any data,"_
        & " (see inner loop of this code)).", 65, "Ready To Execute")_
then msgBox "Nothing to do. All done.",, ";-)": wScript.quit

dim FSO,f, include,exclude, R,G,B, Red,Green,Blue, RGB
set FSO=createObject("scripting.fileSystemObject")
set f = fso.openTextFile(fullySpecFile_W, 2, true)
for R = 0 to 255 step 51
  for G = 0 to 255 step 51
    for B = 0 to 255 step 51
      Red = right("0" & hex(R),2)
      Green=right("0" & hex(G),2)
      Blue =right("0" & hex(B),2)
      RGB = Red & Green & Blue
      include=true
      for each exclude in array("000000","FFFFFF")
        if RGB=exclude then include=false: exit for
      next
      if include then f.writeLine "#" & RGB
    next
  next
next
f.close: set f=nothing: set FSO=f

createObject("wScript.shell").run"Notepad " & fullySpecFile_W, 1, true
'OR: msgBox "All done.", 1, ";-)"
-Top- Page 11 | Nomenclature